home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic 4 Database How-To / Visual Basic 4 Database - How-to (The Waite Group)(1995).iso / dde.ba_ / dde.ba
Text File  |  1995-07-05  |  2KB  |  62 lines

  1. Attribute VB_Name = "Module1"
  2. Option Explicit
  3.  
  4. ' Declare the Windows API function GetProfileString
  5. ' The #IF logic makes sure the correct function is declared
  6. ' based on whether you are using a 16-bit or 32-bit environment.
  7. #If Win32 Then
  8.     Declare Function GetProfileString Lib "kernel32" Alias "GetProfileStringA" _
  9.         (ByVal lpAppName As String, ByVal lpKeyName As String, _
  10.         ByVal lpDefault As String, ByVal lpReturnedString As String, _
  11.         ByVal nSize As Long) As Long
  12. #Else
  13.     Declare Function GetProfileString Lib "Kernel" (ByVal lpAppName$, _
  14.         ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnString As String, _
  15.         ByVal nSize As Integer) As Integer
  16. #End If
  17.  
  18. Function AccessPath() As String
  19.     Const MAXPATHLENGTH = 128
  20.     Dim lpAppName As String
  21.     Dim lpKeyName As String
  22.     Dim lpDefault As String
  23.     Dim lpReturnString As String * MAXPATHLENGTH
  24.     Dim nSize As Integer
  25.     Dim pathLength As Integer
  26.     Dim thePath As String
  27.     Dim endOfPath As Integer
  28.     
  29.     ' Set the parameters to pass to GetProfileString.
  30.     lpAppName = "Extensions"
  31.     lpKeyName = "MDB"
  32.     lpDefault = ""
  33.     nSize = MAXPATHLENGTH
  34.     
  35.     ' Call GetProfileString. It puts the pathname (if it finds it) into
  36.     ' the lpReturnString argument and returns the length of the path name.
  37.     pathLength = GetProfileString(lpAppName, lpKeyName, lpDefault, _
  38.         lpReturnString, nSize)
  39.         
  40.     If pathLength > 0 Then
  41.         
  42.         ' We have a path name, but it probably includes at the end a
  43.         ' space followed by ^.MDB. If that's the case, strip off the
  44.         ' extraneous extra stuff.
  45.         thePath = Left$(lpReturnString, pathLength)
  46.         endOfPath = InStr(thePath, " ") - 1
  47.         
  48.         ' Return the pathname to the calling routine.
  49.         If endOfPath > 0 Then
  50.             AccessPath = Left$(thePath, endOfPath)
  51.         Else
  52.             AccessPath = thePath
  53.         End If
  54.     Else
  55.     
  56.         ' We found no path, so return an empty string.
  57.         AccessPath = ""
  58.     End If
  59.     
  60. End Function
  61.  
  62.